Info-Mac 4/Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso/Development/Source/DBL Pascal Library/AsyncSound/AsyncSound.p

Text File | 1993-02-09 | 12KB | 422 lines

unit AsyncSound;

{February 9, 1992 — Detached resources made unpurgeable. Create channel with no synth.}
{    More error recovery. More documentation.}
{February 8, 1993 — Dispose sound channel if SndPlay gives an error.}
{November 28, 1992 — Call idle routine at start of inquiry routines.}
{August 7, 1992 — Don’t try to call nonexistent notify proc when manager is closed.}
{July 1992 — Corrected queueing of multiple calls; revised interface.}
{December 20, 1991 — Initial version.}

interface

    const
        AsyncSoundMaxChannels = 4;

{Init internal data for the specified number of channels. All channel modes set to initMono.}
{If the Macintosh system version is prior to 6.0.7, all other AsyncSound unit calls become}
{no–ops; this means you don’t have to test for sound manager presence at each call.}
    function AsyncSoundInit (numberOfChannels: Integer): OSErr;

{Stop all sounds immediately. Call before _ExitToShell, if sounds might be active.}
{Notify procs for unfinished sounds will not be called. Also, if you call any AsyncSound unit}
{routines after the close, they’ll succeed without doing anything.}
    procedure AsyncSoundClose;

{NOTE: All routines having a ‘whichChannel’ parameter return ‘paramErr’ on an invalid channel.}
{The following three routines play sampled sounds. The sound may be stored in a resource of}
{type 'snd ' and specified by name or ID, or may be passed in a handle. All sounds must be Type 1}
{sounds — sampled sounds must specify the sampled sound synth. A notify proc, if provided}
{is called with the specified message upon completion of the sound. If you don’t use a notify proc,}
{pass nil for the notifyProc parameter. If the new sound manager is not present at init time, or}
{if the AsyncSound unit is closed, the notifyProc will be called immediately. The completion}
{routine will never be called if the Play… function returns an error. The resource-based}
{routines detach the sound resource and make it unpurgeable before playing. The handle-based}
{routine depends upon the caller maintaining the state of the handle, perhaps using callbacks.}
    function PlayAsyncNamedSoundResource (soundName: Str255; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
    function PlayAsyncSoundResource (soundID: Integer; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
    function PlayAsyncSoundHandle (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;

{A channel’s mode can be changed to any other mode valid for a sampled sound (see the Sound}
{Manager chapter of Inside Mac VI). The new mode becomes effective when the channel is idle;}
{it does not affect a currently active channel.}
    procedure SetAsyncSoundChannelMode (mode: Longint; whichChannel: Integer);

{Return true if the specified channel is playing a sound.}
    function AsyncSoundChannelActive (whichChannel: Integer): Boolean;

{Stop all sound playback on the specified channel. This stops the current sound, and any sounds}
{which are queued for playback. Notify procs are not called for aborted sounds.}
    function AsyncSoundChannelAbort (whichChannel: Integer): OSErr;

{Return the number of a not–busy channel, or zero if all channels are currently playing sounds.}
    function FindFreeAsyncSoundChannel: Integer;

{Call this periodically to adjust queues and dispose memory. Notify procs are called at this time.}
    procedure AsyncSoundIdle;

implementation

    uses
        Sound;

    type
        ASndQEl = record
                qLink: QElemPtr;
                qType: Integer;
                aQPlaying: Boolean;
                aQCompletionCode: Integer;
                aQSoundHandle: Handle;
                aQNotifyProc: ProcPtr;
                aQNotifyMsg: Longint;
            end;
        ASndQElPtr = ^ASndQEl;
        SoundArrayElt = record
                initMode: Longint;
                soundMgrChannel: SndChannelPtr;
                completionQueue: QHdr;
            end;
        SoundArrayHdr = Integer;
        SoundArray = record
                count: SoundArrayHdr;
                channels: array[1..1] of SoundArrayElt;
            end;
        SoundArrayPtr = ^SoundArray;
        SoundArrayHdl = ^SoundArrayPtr;

    var
        theAsyncChannels: SoundArrayHdl;

    function AsyncSoundInit (numberOfChannels: Integer): OSErr;

        procedure Check (result: Integer);
        begin
            AsyncSoundInit := result;
            if result <> noErr then
                begin
                    theAsyncChannels := nil;
                    Exit(AsyncSoundInit);
                end;
        end;

        var
            environs: SysEnvRec;
            i: Integer;

    begin
        Check(SysEnvirons(1, environs));
        if environs.systemVersion < $0607 then    {we don’t have the new sound manager}
            Check(-1);
        if (numberOfChannels <= 0) or (numberOfChannels > AsyncSoundMaxChannels) then
            Check(paramErr);
        theAsyncChannels := SoundArrayHdl(NewHandleClear(SIZEOF(SoundArrayHdr) + SIZEOF(SoundArrayElt) * numberOfChannels));
        if theAsyncChannels <> nil then
            with theAsyncChannels^^ do
                begin
                    count := numberOfChannels;
                    for i := 1 to count do
{$PUSH}
{$R-}
                        channels[i].initMode := initMono;
{$POP}
                end;
        Check(MemError);
    end;

    procedure AsyncSoundClose;
        var
            whichChannel: Integer;
            myErr: OSErr;
    begin
        if theAsyncChannels <> nil then
            begin
                for whichChannel := 1 to theAsyncChannels^^.count do
                    myErr := AsyncSoundChannelAbort(whichChannel);
                DisposHandle(Handle(theAsyncChannels));
                theAsyncChannels := nil;
            end;
    end;

    function FindFreeAsyncSoundChannel: Integer;
        var
            whichChannel: Integer;
    begin
        AsyncSoundIdle;
        FindFreeAsyncSoundChannel := 0;
        if theAsyncChannels <> nil then
            with theAsyncChannels^^ do
                for whichChannel := 1 to count do
{$PUSH}
{$R-}
                    with channels[whichChannel], completionQueue do
{$POP}
                        if qHead = nil then
                            begin
                                FindFreeAsyncSoundChannel := whichChannel;
                                Leave;
                            end;
    end;

    const
        kResourceSoundComplete = 1;
        kHandleSoundComplete = 2;

{$PUSH}
{$D-}
{$V-}
{$R-}
    procedure PlayAsyncCallback (chan: SndChannelPtr; cmd: SndCommand);
    begin
        case cmd.param1 of
            kResourceSoundComplete, kHandleSoundComplete:
                ASndQElPtr(cmd.param2)^.aQPlaying := False;
            otherwise
                ;
        end;
    end;
{$POP}

    procedure DoNotifyJSR (msg: Longint; proc: ProcPtr);
    inline
        $205F,            {movea.l (sp)+,a0}
        $4E90;            {jsr (a0)}

    procedure PopQueue (whichChannel: Integer);
        var
            poppedQElem: Ptr;
            myErr: OSErr;
    begin
{$PUSH}
{$R-}
        with theAsyncChannels^^.channels[whichChannel], completionQueue do
{$POP}
            begin
                poppedQElem := Ptr(qHead);
                myErr := Dequeue(qHead, @completionQueue);
                DisposePtr(poppedQElem);
            end;
    end;

    procedure AsyncSoundIdle;
        var
            whichChannel: Integer;
            firstQElt: aSndQElPtr;
            myErr: OSErr;
    begin
        if theAsyncChannels <> nil then
            begin
                HLock(Handle(theAsyncChannels));
                with theAsyncChannels^^ do
                    for whichChannel := 1 to count do
{$PUSH}
{$R-}
                        with channels[whichChannel] do
{$POP}
                            begin
                                if completionQueue.qHead <> nil then
                                    repeat
                                        firstQElt := aSndQElPtr(completionQueue.qHead);
                                        with firstQElt^ do
                                            if not aQPlaying then
                                                begin
                                                    if aQCompletionCode = kResourceSoundComplete then
                                                        DisposHandle(aQSoundHandle);
                                                    if aQNotifyProc <> nil then
                                                        DoNotifyJSR(aQNotifyMsg, aQNotifyProc);
                                                    PopQueue(whichChannel);
                                                end;
                                    until (completionQueue.qHead = nil) | firstQElt^.aQPlaying;
                                if completionQueue.qHead = nil then
                                    begin
                                        myErr := SndDisposeChannel(soundMgrChannel, True);
                                        soundMgrChannel := nil;
                                    end;
                            end;
                HUnlock(Handle(theAsyncChannels));
            end;
    end;

    function ChannelNumberOK (whichChannel: Integer): Boolean;
    begin
        ChannelNumberOK := (whichChannel > 0) and (whichChannel <= theAsyncChannels^^.count);
    end;

    function AsyncSoundChannelAbort (whichChannel: Integer): OSErr;
    begin
        if theAsyncChannels <> nil then
            begin
                if ChannelNumberOK(whichChannel) then
                    begin
                        HLock(Handle(theAsyncChannels));
{$PUSH}
{$R-}
                        with theAsyncChannels^^.channels[whichChannel] do
{$POP}
                            begin
                                AsyncSoundChannelAbort := SndDisposeChannel(soundMgrChannel, True);
                                while completionQueue.qHead <> nil do
                                    PopQueue(whichChannel);
                            end;
                        HUnlock(Handle(theAsyncChannels));
                    end
                else
                    AsyncSoundChannelAbort := paramErr;
            end
        else
            AsyncSoundChannelAbort := noErr;
    end;

    function PlayAsyncSound (soundHandle: Handle; whichChannel: Integer; completionCode: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;

        var
            mySndChan: SndChannelPtr;

        procedure Check (result: OSErr);
            var
                err: OSErr;
        begin
            PlayAsyncSound := result;
            if result <> noErr then
                begin
                    if mySndChan <> nil then
                        err := SndDisposeChannel(mySndChan, True);
                    Exit(PlayAsyncSound);
                end;
        end;

        const
            noSynth = 0;

        var
            mySndCmd: SndCommand;

    begin {PlayAsyncSound}
        if not ChannelNumberOK(whichChannel) then
            Check(paramErr);
{$PUSH}
{$R-}
        with theAsyncChannels^^.channels[whichChannel] do
{$POP}
            if completionQueue.qHead = nil then
                begin
                    mySndChan := nil;
                    Check(SndNewChannel(mySndChan, noSynth, initMode, @PlayAsyncCallback));
                end
            else
                mySndChan := soundMgrChannel;
        Check(SndPlay(mySndChan, soundHandle, True));
        with mySndCmd do
            begin
                cmd := callBackCmd;
                param1 := completionCode;
                param2 := Longint(NewPtr(SIZEOF(ASndQEl)));
                with ASndQElPtr(param2)^ do
                    begin
                        aQPlaying := True;
                        aQCompletionCode := completionCode;
                        aQSoundHandle := soundHandle;
                        aQNotifyProc := notifyProc;
                        aQNotifyMsg := notifyMsg;
                    end;
{$PUSH}
{$R-}
                with theAsyncChannels^^.channels[whichChannel] do
{$POP}
                    begin
                        soundMgrChannel := mySndChan;
                        Enqueue(QElemPtr(param2), @completionQueue);
                    end;
            end;
        Check(SndDoCommand(mySndChan, mySndCmd, False));
    end;

    function PlayResource (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: Longint): OSErr;
        var
            err: OSErr;
    begin
        DetachResource(soundHandle);
        HNoPurge(soundHandle);
        err := PlayAsyncSound(soundHandle, whichChannel, kResourceSoundComplete, notifyProc, notifyMsg);
        if err <> noErr then
            DisposeHandle(soundHandle);
        PlayResource := err;
    end;

    function PlayAsyncNamedSoundResource (soundName: Str255; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
        var
            soundHandle: Handle;
    begin
        if theAsyncChannels <> nil then
            begin
                soundHandle := GetNamedResource('snd ', soundName);
                if soundHandle <> nil then
                    PlayAsyncNamedSoundResource := PlayResource(soundHandle, whichChannel, notifyProc, notifyMsg)
                else
                    PlayAsyncNamedSoundResource := ResError;
            end
        else
            begin
                if notifyProc <> nil then
                    DoNotifyJSR(notifyMsg, notifyProc);
                PlayAsyncNamedSoundResource := noErr;
            end;
    end;

    function PlayAsyncSoundResource (soundID: Integer; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
        var
            soundHandle: Handle;
    begin
        if theAsyncChannels <> nil then
            begin
                soundHandle := GetResource('snd ', soundID);
                if soundHandle <> nil then
                    PlayAsyncSoundResource := PlayResource(soundHandle, whichChannel, notifyProc, notifyMsg)
                else
                    PlayAsyncSoundResource := ResError;
            end
        else
            begin
                if notifyProc <> nil then
                    DoNotifyJSR(notifyMsg, notifyProc);
                PlayAsyncSoundResource := noErr;
            end;
    end;

    function PlayAsyncSoundHandle (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
    begin
        if theAsyncChannels <> nil then
            PlayAsyncSoundHandle := PlayAsyncSound(soundHandle, whichChannel, kHandleSoundComplete, notifyProc, notifyMsg)
        else
            begin
                if notifyProc <> nil then
                    DoNotifyJSR(notifyMsg, notifyProc);
                PlayAsyncSoundHandle := noErr;
            end;
    end;

    procedure SetAsyncSoundChannelMode (mode: Longint; whichChannel: Integer);
    begin
        if theAsyncChannels <> nil then
            if ChannelNumberOK(whichChannel) then
{$PUSH}
{$R-}
                theAsyncChannels^^.channels[whichChannel].initMode := mode;
{$POP}
    end;

    function AsyncSoundChannelActive (whichChannel: Integer): Boolean;
    begin
        AsyncSoundIdle;
        if theAsyncChannels <> nil then
            begin
                if ChannelNumberOK(whichChannel) then
{$PUSH}
{$R-}
                    AsyncSoundChannelActive := theAsyncChannels^^.channels[whichChannel].completionQueue.qHead <> nil;
{$POP}
            end
        else
            AsyncSoundChannelActive := False;
    end;

end.